Extended Figure 25-A,B,C
junio 11, 2021
0.1 Introduction
In this Rmarkdown we are going to plot panels D, G & H. In this script we will use the the scRNAseq data from sc_analysis/04-annotation/07-join_annotation.Rmd.
0.2 Libraries
library(Seurat)
library(ggpubr)
library(cowplot)
library(dplyr)
library(ggplot2)
library(RColorBrewer)
library(glue)
library(stringr)
library(readr)0.3 Setting parameters
Loading necessary paths and parameters
set.seed(123)
source(here::here("misc/paths.R"))
source(here::here("utils/bin.R"))
"{fig_pt}/{plt_dir}" %>%
glue::glue() %>%
here::here() %>%
dir.create(
path = .,
showWarnings = FALSE,
recursive = TRUE)
"{fig_pt}/{robj_dir}" %>%
glue::glue() %>%
here::here() %>%
dir.create(
path = .,
showWarnings = FALSE,
recursive = TRUE)
img_order <- c("uzntl1_fkclxp", "k886qc_rqix54","s2yq8o_t5hk8u", "ivuznh_s8xyfv")
SpatialColors <- colorRampPalette(colors = rev(x = brewer.pal(n = 11, name = "Spectral")))0.4 Load data
Load Visium data
# 07-sc_mapping_viz.Rmd
# se_obj <- "{map_27}/{robj_dir}/se_deconv_{sample_id}_epid20_pre-rotation.rds"
sp_ls <- lapply(id_sp_df$gem_id, function(id) {
se_obj <- "{map_27}/{robj_dir}/se_deconv_{id}_epid20.rds" %>%
glue::glue() %>%
here::here() %>%
readRDS(file = .)
return(se_obj)
})
se_obj <- merge(sp_ls[[1]], y = sp_ls[2:length(sp_ls)],
add.cell.ids = id_sp_df$gem_id,
project = "Gloria-Salva")0.5 Panels
0.5.1 Panel A
In this panel we show the HE images and the mouse percentage per spot.
row1_a <- Seurat::SpatialPlot(
object = se_obj,
features = "GRCh38-AGL",
alpha = c(0, 0),
images = img_order,
crop = FALSE,
image.alpha = 1,
pt.size.factor = 1.25) &
Seurat::NoLegend() &
ggplot2::labs(title = "")
row1_a
row2_a <- Seurat::SpatialPlot(
object = se_obj,
features = c("percent.mouse"),
images = img_order,
crop = FALSE,
image.alpha = 0,
pt.size.factor = 1.25) &
ggplot2::scale_fill_gradientn(
colours = SpatialColors(n = 100),
limits = c(0, 1)) &
ggplot2::labs(title = "")
row2_a <- ggpubr::ggarrange(row2_a[[1]], row2_a[[2]], row2_a[[3]], row2_a[[4]],
ncol = 4, common.legend = TRUE, legend = "right")
row2_a
"{fig_pt}/{plt_dir}/Extended_25-A1.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = row1_a,
base_height = 4,
base_width = 16)
"{fig_pt}/{plt_dir}/Extended_25-A2.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = row2_a,
base_height = 4,
base_width = 16)0.5.2 Panel B
In this image we show the tumor-associated Schwann cells predicted proportion along with the mouse percentage and the tissue stratification.
Stratify the tissue
se_obj@meta.data <- se_obj@meta.data %>%
dplyr::mutate(
stratification = dplyr::case_when(
sample_id == "GP027_PKLO_Palm_Diet" & Spatial_snn_res.0.5 %in% c(0, 2, 5) ~ "Tumour",
sample_id == "GP027_PKLO_Palm_Diet" & Spatial_snn_res.0.5 == 3 ~ "Tumour Front",
sample_id == "GP027_PKLO_Palm_Diet" & Spatial_snn_res.0.5 %in% c(1, 4, 6, 7, 8) ~ "Healthy",
sample_id == "GP20004_dKDCD36_CT_Diet" & Spatial_snn_res.0.1 == 1 ~ "Tumour",
sample_id == "GP20004_dKDCD36_CT_Diet" & Spatial_snn_res.0.1 == 2 ~ "Tumour Front",
sample_id == "GP20004_dKDCD36_CT_Diet" & Spatial_snn_res.0.1 %in% c(0, 3) ~ "Healthy",
sample_id == "GP029_PLKO_CT_Diet" & Spatial_snn_res.0.3 == 4 ~ "Tumour",
sample_id == "GP029_PLKO_CT_Diet" & Spatial_snn_res.0.3 == 3 ~ "Tumour Front",
sample_id == "GP029_PLKO_CT_Diet" & ! Spatial_snn_res.0.3 %in% c(3, 4) ~ "Healthy",
sample_id == "GP024_dKDCD36_Palm_Diet" & Spatial_snn_res.1 %in% c(3, 7) ~ "Tumour",
sample_id == "GP024_dKDCD36_Palm_Diet" & Spatial_snn_res.1 %in% c(6, 8) ~ "Tumour Front",
sample_id == "GP024_dKDCD36_Palm_Diet" & ! Spatial_snn_res.1 %in% c(3, 6, 7, 8) ~ "Healthy"
),
stratification = factor(stratification,
levels = c("Healthy", "Tumour Front", "Tumour"))
)Plot arrangement
b_ls <- lapply(img_order, function(img) {
# Schwann cells
tmp1 <- Seurat::SpatialPlot(
object = se_obj,
features = c("Tumour-associated Schwann Cells"),
images = img,
crop = FALSE,
image.alpha = 0,
pt.size.factor = 1.25) &
ggplot2::scale_fill_gradientn(
colours = SpatialColors(n = 100),
limits = c(0, max(se_obj$`Tumour-associated Schwann Cells`)))
# percent.mouse
tmp2 <- Seurat::SpatialPlot(
object = se_obj,
features = c("percent.mouse"),
images = img,
crop = FALSE,
image.alpha = 0,
pt.size.factor = 1.25) &
ggplot2::scale_fill_gradientn(
colours = SpatialColors(n = 100),
limits = c(0, 1))
# percent.mouse
tmp3 <- Seurat::SpatialPlot(
object = se_obj,
group.by = "stratification",
images = img,
crop = FALSE,
image.alpha = 0,
pt.size.factor = 1.25) +
ggplot2::scale_fill_manual(
values = c("#009E73", "#E69F00", "#D55E00"),
breaks = c("Healthy", "Tumour Front", "Tumour")) +
ggplot2::theme(legend.position = "top") +
ggplot2::guides(
fill = ggplot2::guide_legend(override.aes = list(size = 5)))
cowplot::plot_grid(
plotlist = list(tmp1, tmp2, tmp3),
align = "hv",
axis = "trbl",
nrow = 1)
})Join the sub-panels of panel B
panel_b <- plot_grid(plotlist = b_ls, ncol = 2, align = "hv", axis = "trbl")
panel_b
"{fig_pt}/{plt_dir}/Extended_25-B.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = panel_b,
base_height = 12,
base_width = 30)0.5.3 Panel C
In this panel we show the violin plots of the predicted proportions of tumour-associated Schwann cells stratified by healthy, tumour front and tumour.
my_comparisons <- list(
c("Tumour", "Tumour Front"),
c("Tumour", "Healthy"),
c("Tumour Front", "Healthy")
)
panel_c <- se_obj@meta.data %>%
dplyr::mutate(
sample_id = factor(sample_id,
levels = c( "GP027_PKLO_Palm_Diet", "GP029_PLKO_CT_Diet",
"GP024_dKDCD36_Palm_Diet", "GP20004_dKDCD36_CT_Diet"))
) %>%
ggplot2::ggplot(.,
ggplot2::aes(x = stratification, y = `Tumour-associated Schwann Cells`)) +
ggplot2::geom_violin(
alpha = 0.7,
ggplot2::aes(fill = stratification, color = stratification)) +
ggplot2::geom_jitter(ggplot2::aes(color = stratification)) +
ggplot2::facet_wrap(.~sample_id, scales = "free") +
ggplot2::labs(
x = "Tissue Stratification",
y = "Proportion of Tumour-associated Schwann Cells") +
ggplot2::theme_classic() +
ggpubr::stat_compare_means(
label = "p.format",
comparisons = my_comparisons,
p.adjust.method = "bonferroni",
) +
# ggpubr::stat_compare_means(label.y = c(0.75, 0.5, 0.85, 0.75)) + # Add global p-value
ggplot2::scale_fill_manual(values = c("#009E73", "#E69F00", "#D55E00")) +
ggplot2::scale_color_manual(values = c("#009E73", "#E69F00", "#D55E00")) +
ggplot2::theme(legend.title = element_blank())
panel_c
"{fig_pt}/{plt_dir}/Extended_25-C.pdf" %>%
glue::glue() %>%
here::here() %>%
cowplot::save_plot(
filename = .,
plot = panel_c,
base_height = 9,
base_width = 12)0.6 Session Info
sessionInfo()## R version 4.0.4 (2021-02-15)
## Platform: x86_64-pc-linux-gnu (64-bit)
## Running under: Ubuntu 20.04.2 LTS
##
## Matrix products: default
## BLAS: /usr/local/lib/R/lib/libRblas.so
## LAPACK: /usr/local/lib/R/lib/libRlapack.so
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=es_ES.UTF-8 LC_TIME=es_ES.UTF-8 LC_COLLATE=en_US.UTF-8 LC_MONETARY=es_ES.UTF-8 LC_MESSAGES=en_US.UTF-8 LC_PAPER=es_ES.UTF-8 LC_NAME=es_ES.UTF-8 LC_ADDRESS=es_ES.UTF-8 LC_TELEPHONE=es_ES.UTF-8 LC_MEASUREMENT=es_ES.UTF-8 LC_IDENTIFICATION=es_ES.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] readr_1.4.0 stringr_1.4.0 glue_1.4.2 RColorBrewer_1.1-2 dplyr_1.0.6 cowplot_1.1.1 ggpubr_0.4.0 ggplot2_3.3.3 SeuratObject_4.0.1 Seurat_4.0.2 BiocStyle_2.18.1
##
## loaded via a namespace (and not attached):
## [1] readxl_1.3.1 backports_1.2.1 plyr_1.8.6 igraph_1.2.6 lazyeval_0.2.2 splines_4.0.4 listenv_0.8.0 scattermore_0.7 digest_0.6.27 htmltools_0.5.1.1 magick_2.7.2 fansi_0.4.2 magrittr_2.0.1 tensor_1.5 cluster_2.1.0 ROCR_1.0-11 openxlsx_4.2.3 globals_0.14.0 matrixStats_0.58.0 spatstat.sparse_2.0-0 colorspace_2.0-1 ggrepel_0.9.1 haven_2.4.1 xfun_0.23 crayon_1.4.1 jsonlite_1.7.2 spatstat.data_2.1-0 survival_3.2-7 zoo_1.8-9 polyclip_1.10-0 gtable_0.3.0 leiden_0.3.8 car_3.0-10 future.apply_1.7.0 abind_1.4-5 scales_1.1.1 DBI_1.1.1 rstatix_0.7.0 miniUI_0.1.1.1 Rcpp_1.0.6 viridisLite_0.4.0 xtable_1.8-4 reticulate_1.20 spatstat.core_2.1-2 foreign_0.8-81 htmlwidgets_1.5.3 httr_1.4.2 ellipsis_0.3.2 ica_1.0-2 farver_2.1.0 pkgconfig_2.0.3 sass_0.4.0 uwot_0.1.10 deldir_0.2-10
## [55] utf8_1.2.1 here_1.0.1 labeling_0.4.2 tidyselect_1.1.1 rlang_0.4.11 reshape2_1.4.4 later_1.2.0 munsell_0.5.0 cellranger_1.1.0 tools_4.0.4 cli_2.5.0 generics_0.1.0 broom_0.7.6 ggridges_0.5.3 evaluate_0.14 fastmap_1.1.0 yaml_2.2.1 goftest_1.2-2 knitr_1.33 fitdistrplus_1.1-3 zip_2.1.1 purrr_0.3.4 RANN_2.6.1 pbapply_1.4-3 future_1.21.0 nlme_3.1-152 mime_0.10 compiler_4.0.4 rstudioapi_0.13 plotly_4.9.3 curl_4.3.1 png_0.1-7 ggsignif_0.6.1 spatstat.utils_2.1-0 tibble_3.1.2 bslib_0.2.5.1 stringi_1.6.2 highr_0.9 forcats_0.5.1 lattice_0.20-41 Matrix_1.3-3 vctrs_0.3.8 pillar_1.6.1 lifecycle_1.0.0 BiocManager_1.30.15 spatstat.geom_2.1-0 lmtest_0.9-38 jquerylib_0.1.4 RcppAnnoy_0.0.18 data.table_1.14.0 irlba_2.3.3 httpuv_1.6.1 patchwork_1.1.1 R6_2.5.0
## [109] bookdown_0.22 promises_1.2.0.1 KernSmooth_2.23-18 gridExtra_2.3 rio_0.5.26 parallelly_1.25.0 codetools_0.2-18 MASS_7.3-53 assertthat_0.2.1 rprojroot_2.0.2 withr_2.4.2 sctransform_0.3.2 mgcv_1.8-33 parallel_4.0.4 hms_1.1.0 grid_4.0.4 rpart_4.1-15 tidyr_1.1.3 rmarkdown_2.8 carData_3.0-4 Rtsne_0.15 shiny_1.6.0